home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 1 / Cream of the Crop 1.iso / CAD / PCONFRE2.ARJ / 3DPIPE.LSP next >
Text File  |  1990-12-16  |  6KB  |  160 lines
  1. ;This program will take a ployline, 2D or 3D, and use it as the centerline
  2. ;for a tube.
  3. ;The number of segments for the tube are supplied by "Surftab1" and
  4. ;"Surftab2". You input the Radius and pick the centerline. The program then
  5. ;makes a 3D Mesh Tube. You can fine tune it with Pedit.
  6. ;I got the idea for this program from using Jamie Clay's "Mfit" program.
  7. ;I was drawing a 1.5 inch power cable in 3D to examine how it fit in a
  8. ;cubicale. The procedure I followed was the same as in this program,
  9. ;only I did it manually. When I had to do subsequent cables I decided to
  10. ;incorperate it into a Lisp program. Since "Mfit" did the job in the first
  11. ;place, I decided to build on it. I included credits to Jamie for the part
  12. ;he did. Also you may notice that the defuns he did are not taylor made for
  13. ;this program, I get paid for drawing, not programing, and didn't have the 
  14. ;time to customize everything for optimum performence. None the less I think
  15. ;it is a usefull program and decided to upload it for you guys.
  16. ;As far as I can tell everything works right, let me know if anything is
  17. ;screwed up. Jay Parisi CIS ID 76526,3640  03/13/89
  18.  
  19. (defun c:3dPIPE ()
  20.   (setvar "cmdecho" 0)
  21.   (setq radius (getdist "\nInput radius of tube: "))
  22.   (setq tab1 (getvar "surftab1")) ;set tabs to current surftabs
  23.   (setq tab2 (getvar "surftab2"))
  24.   (setq center nil)
  25. ;get centerline and make sure it a poly
  26.   (while (not center) 
  27.     (setq center (entsel "\nSelect centerline of tube: "))
  28.     (if center
  29.       (progn
  30.         (setq pltest (cdr (assoc 0 (entget (car center)))))
  31.         (if (/= pltest "POLYLINE")
  32.           (progn
  33.             (setq center nil )
  34.             (prompt "\nCenterline of tube must be a polyline")
  35.           )
  36.         )
  37.       )
  38.     )
  39.   )
  40. ;set a undo mark to come back to
  41.   (command "undo" "mark")
  42.   (command "ucs" "w")
  43.   (command "layer" "m" "$$3dcirs$$" "")
  44.   (setq cen (car center))
  45.   (setq divtemp tab2)
  46. ;divide the center line according to surftab2
  47.   (divcenter)
  48. ;find out how much of the arc to leave out so we can use the same function
  49.   (setq circum (* 2 pi radius))
  50.   (setq sector (/ circum tab1))
  51.   (setq arcang (/ sector radius))
  52.   (setq plang (- 360 (rtd arcang)))
  53.   (setq index 0)  
  54.   (command "ucs" "w" )
  55.   (setq XYZpts nil)
  56.   (setq pts nil)
  57.   (setq leth (1+ tab2))
  58. ;get the points to make the segments
  59.   (getpoints)
  60.   (setq divtemp (1- tab1))
  61. ;draw the segments and divide them like the centerline
  62.   (repeat tab2
  63.     (command "ucs" "za" (nth index XYZpts) (nth (1+ index) XYZpts) )
  64.     (command "pline" (list radius 0) "a" "ce" "0,0" "a" plang "")
  65.     (command "ucs" "w" )
  66.     (setq center (entlast))
  67.     (setq center (list center (list radius 0)))
  68.     (setq cen (car center))
  69.     (divcenter)
  70.     (setq index (1+ index))
  71.   )
  72.   (command "ucs" "za" (nth index XYZpts) (nth (1- index) XYZpts) )
  73.   (setq plang (- 0 plang))
  74. ;'cuz we changed the ucs, we gotta reverse the last segment
  75.   (command "pline" (list (- 0 radius) 0) "a" "ce" "0,0" "a" plang "")
  76.   (command "ucs" "w" )
  77.   (setq center (entlast))
  78.   (setq center (list center (list radius 0)))
  79.   (setq cen (car center))
  80. ;divide the last segment
  81.   (divcenter)
  82.   (setq XYZpts nil)
  83.   (setq pts nil)
  84.   (setq leth (* tab1 (1+ tab2)))
  85.   (command "ucs" "w")
  86. ;get the points for the mesh
  87.   (getpoints)
  88.   (command "undo" "back")
  89. ;now make the mesh.
  90.   (command "ucs" "w")
  91.   (command "3dmesh" (1+ tab2) tab1)  ; Start 3dmesh command
  92.   (setq pt# 0)
  93.   (repeat (length XYZpts)
  94.     (setq pt1 (nth pt# XYZpts)) ; pull out a point
  95.     (command pt1)               ; send it to the mesh command
  96.     (setq pt# (1+ pt#))         ; move on
  97.   )
  98. ;close it cuz its a tube
  99.   (command "pedit" "last" "n" "")
  100.   (command "ucs" "p")
  101. )
  102. ;thats it!!! 
  103. ; Divide plines by Jamie Clay
  104. (defun divcenter ()
  105.   (setq lst (entlast))     ; Set last entity
  106.   (setq vtx (entnext cen)) ; Find first vertex
  107.   (setq plbit (cdr (assoc 70 (entget cen)))) ; What kind of pline is this?
  108.   (setq lptA (cdr (assoc 10 (entget vtx))))  ; Set up a last point
  109.   (if (= (logand plbit 1 ) 1 )       ; If open place a first vertex point
  110.     (command "divide" center divtemp)
  111.     (progn
  112.       (command "point" (trans lptA cen 0))         ; first vertex point
  113.       (command "divide" center divtemp)
  114.     )
  115.   )
  116.  
  117. ;Walk to the end of the pline to find the last vertex point
  118.   (while (/= (cdr (assoc 0 (entget (entnext vtx)))) "SEQEND")
  119.     (setq vtx (entnext vtx))
  120.     (setq vrtx (cdr (assoc 0 (entget vtx))))
  121.     (setq lptB (cdr (assoc 10 (entget vtx))))
  122.   )
  123.   (if (= (logand plbit 5 ) 5)  ; if open and spline place last vertex point
  124.     (command "point" (cdr (assoc 10 (entget (entnext lst))))) ; if closed
  125.     (if (= (logand plbit 1) 1)
  126.       (command "point" (trans lptA cen 0)) ; closed pline point
  127.       (command "point" (trans lptB cen 0)) ; last vertex point
  128.     )
  129.   )
  130.   (setq refpt (getass 10 (entlast)))
  131. )
  132. ;get the points for the centerline segments and the mesh. By Jamie Clay
  133. (defun getpoints ()
  134.   (setq pts (ssget "x" '((8 . "$$3dcirs$$") (0 . "POINT")))) ; collect points
  135.   (setq indx 0)                                ; set index
  136.   (repeat leth
  137.     (setq 10pt (get10 (ssname pts indx)))    ; get point value
  138.     (setq indx (1+ indx))                      ; move index
  139.     (if XYZpts
  140.       (setq XYZpts (append XYZpts (list 10pt))) ; add point to list
  141.       (setq XYZpts (list 10pt))                 ; create list if not
  142.     )
  143.   )               
  144. )                                               
  145. ; Get the 3dpoints and trans them if needed
  146. (defun get10 (x)
  147.   (if (= (getvar "worlducs") 0)
  148.     (trans (cdr (assoc 10 (entget x))) 0 1)
  149.     (cdr (assoc 10 (entget x)))
  150.   )
  151. )
  152.  
  153. ; Get as assoc member of an entity
  154. (defun getass(x y)
  155.     (cdr (assoc x  (entget y)))
  156. )
  157. ; turn radians to degrees
  158. (defun rtd (a)
  159.   (/ (* a 180.0) pi)
  160. )